(in-package :clim-user)

(define-application-frame logo-window ()
  ((fun :initarg :fun
	:accessor fun
	:documentation "The function to run to produce the graphics")
   (label :initarg :label
	  :accessor label
	  :initform nil
	  :documentation "A label to display above the picture"))
  (:panes
   (display :application
	    :display-function #'display-display))
  (:layouts
   (default display)))

(defmethod display-display ((frame logo-window) stream)
  (setf *point* (make-point 0 0))
  (setf *theta* 0)
  (when (label frame)
    (surrounding-output-with-border (stream :shape :underline)
      (print (label frame) stream)
      (terpri stream)))
  (with-room-for-graphics (stream)
    (let ((*sheet* stream))
      (funcall (fun frame) stream))))

;; Global state
;;;;;;;;;;;;;;;

(defparameter *point* (make-point 0 0)
  "The location of the turtle")

(defparameter *theta* 0
  "The angle of the turtle, in radians")

(defvar *sheet*)

;; Utility functions
;;;;;;;;;;;;;;;;;;;;

(defun degrees->radians (degrees)
  "Convert degrees to radians"
  (/ (* pi degrees) 180.0d0))

;; Angle functions
;;;;;;;;;;;;;;;;;;

(defun rt (degrees)
  "Turn right a given number of degrees"
  (decf *theta* (degrees->radians degrees)))

(defun lt (degrees)
  "Turn left a given number of degrees"
  (incf *theta* (degrees->radians degrees)))

;; Drawing functions
;;;;;;;;;;;;;;;;;;;;

(defun fd (distance)
  "Go forward a given distance"
  (let ((new-point (make-point (+ (point-x *point*)
				  (* distance (cos *theta*)))
			       (+ (point-y *point*)
				  (* distance (sin *theta*))))))
    (draw-line *sheet* *point* new-point)
    (setf *point* new-point)))

;; PostScript
;;;;;;;;;;;;;

(defun write-postscript (fun filename)
  (with-open-file (file filename
			:direction :output
			:if-exists :supersede)
    (with-output-to-postscript-stream (*standard-output* file)
      (setf *point* (make-point 0 0))
      (setf *theta* 0)
      (with-room-for-graphics (*standard-output*)
	(let ((*sheet* *standard-output*))
	  (funcall fun *sheet*))))))

;; Test
;;;;;;;

(defun test1 (stream)
  (declare (ignore stream))
  (fd 20)
  (lt 90)
  (fd 40)
  (lt 90)
  (fd 20)
  (lt 90)
  (fd 40))

(defun koch (stream &optional (length 550) (iterations 6))
  (declare (ignore stream))
  (labels ((koch-fd (length iter)
	     (if (zerop iter)
		 (fd length)
		 (let ((smaller-length (/ length 3.0d0))
		       (smaller-iter (1- iter)))
		   (koch-fd smaller-length smaller-iter)
		   (lt 60)
		   (koch-fd smaller-length smaller-iter)
		   (rt 120)
		   (koch-fd smaller-length smaller-iter)
		   (lt 60)
		   (koch-fd smaller-length smaller-iter)))))
    (koch-fd length iterations)
    (rt 120)
    (koch-fd length iterations)
    (rt 120)
    (koch-fd length iterations)))

(run-frame-top-level
 (make-application-frame 'logo-window
			 :height 650
			 :width 590
			 :fun #'koch))

(write-postscript #'koch "koch.ps")